knitr::opts_chunk$set(fig.path="gifs/", dpi = 300)
library(tidyverse)
## ── Attaching packages ──────────────────────────────────────── tidyverse 1.2.1.9000 ──
## ✔ ggplot2 3.2.1.9000      ✔ purrr   0.3.2.9000 
## ✔ tibble  2.1.3           ✔ dplyr   0.8.3.9000 
## ✔ tidyr   0.8.99.9000     ✔ stringr 1.4.0      
## ✔ readr   1.3.1           ✔ forcats 0.4.0
## ── Conflicts ──────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
set.seed(1000)
asdpop_base <- tibble::tibble(
  time1 = sample(1:100, 100, replace = F), 
  time2 = time1) %>% 
  tidyr::gather(x, y, time1:time2, factor_key = TRUE)  
asdpop <- asdpop_base %>% 
  mutate(services = as.factor(case_when(
    x == "time1" & y <= 30 ~ 1, 
    x == "time1" & y > 30 ~ 0, 
    x == "time2" & y <= 60 ~ 1, 
    TRUE ~ 0
    )))
dotprint <- ggplot(asdpop, aes(x, y))
dotprint <- dotprint + geom_jitter(aes(fill = services), 
                                   position = position_jitter(width=.25,
                                                              height = 0, 
                                                              seed = 2018),
                                   pch = 21,
                                   colour = "black", 
                                   size = 2) 
dotprint <- dotprint + scale_x_discrete(expand = c(0, 0.6),
                                    name = "", 
                                    labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotprint <- dotprint + scale_y_continuous(expand = c(.02, 0),
                                      name = "ASD Cases per 10,000",
                                      breaks = seq(0, 100, by = 20)) 
dotprint <- dotprint + theme_bw(base_family = "Lato") 
dotprint <- dotprint + theme(axis.ticks = element_blank()) 
dotprint <- dotprint + theme(panel.border = element_blank()) 
dotprint <- dotprint + theme(panel.grid = element_blank()) 
dotprint <- dotprint + theme(axis.title.y = element_text(size = 10)) 
dotprint <- dotprint + theme(axis.text = element_text(size = 10))
dotprint <- dotprint + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2)) 
dotprint <- dotprint + scale_fill_manual(name = "ASD cases who are:", 
                                     values = c("black", "white"), 
                                     labels = c("Not accessing services",
                                                "Accessing services")) 
dotprint <- dotprint + guides(colour = guide_legend(keywidth = 1.1, 
                                keyheight = 1.1, 
                                override.aes = list(alpha = 1, size = 3))) 
dotprint <- dotprint + theme(legend.position=c(.75, .25)) 
dotprint <- dotprint + theme(legend.text = element_text(size = 10)) 
dotprint <- dotprint + theme(legend.title = element_text(size = 10)) 
dotprint <- dotprint + theme(legend.background = element_rect(fill = "gray90", 
                                          size=.3, 
                                          linetype="dotted"))
# top line
dotprint <- dotprint + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100), 
                              lty = 3, lwd = .5, colour = "black") 
dotprint <- dotprint + annotate("text", 
                            x = 2.5, y = 97, size = 4, hjust = 0, 
                            family = "Lato", 
                            label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")  
# bottom line
dotprint <- dotprint + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30), 
                              lty = 3, lwd = .5, colour = "black") 
dotprint <- dotprint + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60), 
                              lty = 3, lwd = .5, colour = "black") 
dotprint <- dotprint + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60), 
                              lty = 3, lwd = .5, colour = "black")
dotprint <- dotprint + annotate("text", 
                            x = 2.5, y = 60, size = 4, hjust = 0, 
                            family = "Lato", 
                            label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.") 
dotprint

library(gganimate)
dotprint +
  transition_layers(layer_length = 1, transition_length = 2,
                    from_blank = FALSE) +
  enter_fade()

pos <- position_jitter(width = .25, 
                       height = 0,
                       seed = 2018)
dotleg <- ggplot(asdpop, aes(x, y))
dotleg <- dotleg + geom_jitter(aes(colour = services), 
                             position = pos, 
                             alpha = .9, size = 2) 
dotleg <- dotleg + scale_x_discrete(expand = c(0, 0.6),
                                    name = "", 
                                    labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotleg <- dotleg + scale_y_continuous(expand = c(.02, 0),
                                      name = "ASD Cases per 10,000",
                                      breaks = seq(0, 100, by = 20)) 
dotleg <- dotleg + theme_bw(base_family = "Lato") 
dotleg <- dotleg + theme(axis.ticks = element_blank()) 
dotleg <- dotleg + theme(panel.border = element_blank()) 
dotleg <- dotleg + theme(panel.grid = element_blank()) 
dotleg <- dotleg + theme(axis.title.y = element_text(size = 10)) 
dotleg <- dotleg + theme(axis.text = element_text(size = 10))
dotleg <- dotleg + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2)) 
dotleg <- dotleg + scale_color_viridis_d(option = "D", begin = .45, end = 1, 
                                     name = "ASD cases who are:",
                                     labels = c("Not accessing services",
                                                 "Accessing services")) 
dotleg <- dotleg + guides(colour = guide_legend(keywidth = 1.1, 
                                keyheight = 1.1, 
                                override.aes = list(alpha = 1, size = 3))) 
dotleg <- dotleg + theme(legend.position=c(.75, .25)) 
dotleg <- dotleg + theme(legend.text = element_text(size = 10)) 
dotleg <- dotleg + theme(legend.title = element_text(size = 10)) 
dotleg <- dotleg + theme(legend.background = element_rect(fill = "gray90", 
                                          size=.3, 
                                          linetype="dotted"))
dottop <- dotleg + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100), 
                              lty = 3, lwd = .5, colour = "black") 
dottop <- dottop + annotate("text", 
                            x = 2.5, y = 97, size = 4, hjust = 0, 
                            family = "Lato", 
                            label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")  
dotboth <- dottop + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30), 
                              lty = 3, lwd = .5, colour = "black") 
dotboth <- dotboth + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60), 
                              lty = 3, lwd = .5, colour = "black") 
dotboth <- dotboth + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60), 
                              lty = 3, lwd = .5, colour = "black")
dotboth <- dotboth + annotate("text", 
                            x = 2.5, y = 60, size = 4, hjust = 0, 
                            family = "Lato", 
                            label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.") 
dotboth

dotboth + 
  transition_layers(layer_length = 2, transition_length = 2) +
  #enter_grow() +
  enter_fade() +
  enter_recolour(colour = 'black') 
## Warning in lapply(data, as.numeric): NAs introduced by coercion

dotanim <- ggplot() 
dotanim <- dotanim + geom_jitter(data = asdpop,
                                 aes(x, y),
                                 colour = viridisLite::magma(1, begin = .1),
                                 position = position_jitter(width = .25, 
                                                            height = 0, 
                                                            seed = 2018), 
                                 alpha = .9, size = 2) 
dotanim <- dotanim + geom_jitter(data = asdpop,
                                 aes(x, y, colour = services), 
                                 position = position_jitter(width = .25, 
                                                            height = 0,
                                                            seed = 2018), 
                                 alpha = .75, size = 2) 
dotanim <- dotanim + scale_x_discrete(expand = c(0, 0.6),
                                      name = "", 
                                      labels = c("Time 1:\nPoor Service Access", "Time 2:\nBetter Service Access"))
dotanim <- dotanim + scale_y_continuous(expand = c(.02, 0),
                                        name = "ASD Cases per 10,000",
                                        breaks = seq(0, 100, by = 20)) 
dotanim <- dotanim + theme_bw(base_family = "Lato") 
dotanim <- dotanim + theme(axis.ticks = element_blank()) 
dotanim <- dotanim + theme(panel.border = element_blank()) 
dotanim <- dotanim + theme(panel.grid = element_blank()) 
dotanim <- dotanim + theme(axis.title.y = element_text(size = 10)) 
dotanim <- dotanim + theme(axis.text = element_text(size = 10))
dotanim <- dotanim + guides(colour = guide_legend(keywidth = 1.1, 
                                                  keyheight = 1.1, 
                                                  override.aes = list(alpha = 1, size = 3))) 
dotanim <- dotanim + theme(legend.position=c(.75, .25)) 
dotanim <- dotanim + theme(legend.text = element_text(size = 10)) 
dotanim <- dotanim + theme(legend.title = element_text(size = 10)) 
dotanim <- dotanim + theme(legend.background = element_rect(fill = "gray90", 
                                                            size=.3, 
                                                            linetype="dotted"))
dotanim <- dotanim + coord_cartesian(ylim = c(0, 102), xlim = c(1, 3.2)) 
dotanim <- dotanim + scale_color_viridis_d(option = "A", begin = .1, end = .7, 
                                           name = "ASD cases who are:",
                                           labels = c("Not accessing services",
                                                      "Accessing services"))
# top lines
dotanim <- dotanim + geom_segment(aes(x = .6, xend = 2.4, y = 100, yend = 100), 
                                  lty = 3, lwd = .5, colour = "black") 
dotanim <- dotanim + annotate("text", 
                              x = 2.5, y = 97, size = 4, hjust = 0, 
                              family = "Lato", 
                              label = "Estimates of prevalence based\non population sampling will remain\nstable over time if true prevalence\nis stable.")  
# bottom line
dotanim <- dotanim + geom_segment(aes(x = .6, xend = 1.3, y = 30, yend = 30), 
                                  lty = 3, lwd = .5, colour = "black") 
dotanim <- dotanim + geom_segment(aes(x = 1.3, xend = 1.7, y = 30, yend = 60), 
                                  lty = 3, lwd = .5, colour = "black") 
dotanim <- dotanim + geom_segment(aes(x = 1.7, xend = 2.4, y = 60, yend = 60), 
                                  lty = 3, lwd = .5, colour = "black")
dotanim <- dotanim + annotate("text", 
                              x = 2.5, y = 60, size = 4, hjust = 0, 
                              family = "Lato", 
                              label = "Estimates of prevalence based\non individuals accessing services\ncan create an illusion of an\nincrease in prevalence over time,\nyet still underestimate prevalence\nat both time points.") 

# animate this thing
dotanim <- dotanim + 
  transition_layers(layer_length = 2, transition_length = 2,
                    keep_layers = c(0, Inf, Inf, Inf, Inf, Inf, Inf)) +
  enter_fade()

animate(dotanim, start_pause = 5, end_pause = 20)